SCREEN 2,320,250,5,1
WINDOW 2,"           RAUMGESTALTUNG",,0,2
  PALETTE 29,0,0,0      
  PALETTE 1,0.8,0,0     
  PALETTE 2,1,0,0      
  PALETTE 3,0.93,0.2,0   
  PALETTE 4,1,0.4,0     
  PALETTE 5,1,0.6,0     
  PALETTE 6,1,0.8,0     
  PALETTE 7,1,1,0     
  PALETTE 8,0.6,1,0.15   
  PALETTE 9,0.5,0.8,0.15  
  PALETTE 10,0.4,0.6,0   
  PALETTE 11,0.2,0.4,0   
  PALETTE 12,0,0.4,0    
  PALETTE 13,0,0.6,0.67  
  PALETTE 14,0,0.8,0.6   
  PALETTE 15,0,1,0.6   
  PALETTE 16,0.2,1,0.93  
  PALETTE 17,0.2,0.75,1  
  PALETTE 18,0.15,0.4,1  
  PALETTE 19,0.4,0,1    
  PALETTE 20,0,0,0.6    
  PALETTE 21,0.35,0.15,0.8
  PALETTE 22,0.6,0.2,1   
  PALETTE 23,1,0,1     
  PALETTE 24,0.9,0.5,0.75 
  PALETTE 25,1,0.75,0.75 
  PALETTE 26,0.8,0.55,0.5 
  PALETTE 27,0.6,0.4,0.35 
  PALETTE 28,0.4,0.2,0   
  PALETTE 0,0.6,0.6,0.6  
  PALETTE 30,0.6,0.6,0.6   
  PALETTE 31,0.7,0.7,0.7    
   CLEAR ,20000                
   DIM bau(110,20)  
   w=1:mx=-1:my=0
   FOR ein=1 TO 20
ON ein GOSUB radier,fenstero,fensteru,fensterl,fensterr,kreuz,vierb,tisch,stuhlk,kasten,balkeno,balkenu,links,rechts,stuhl,eckelu,eckero,eckeol,eckeur,tischgr
   GET(0,0)-(19,19),bau(110,ein-1)
   CLS               
   NEXT
   GOSUB Rahmen : GOSUB bauen   
retur:
   MENU ON
   WHILE MOUSE(0) = 0
   x = MOUSE(1): y = MOUSE(2)
   IF y<180 THEN
   PUT(x-10,y-5),bau(110,w)
   PUT(x-10,y-5),bau(110,w)
   END IF
   WEND       
   IF x> = 300 THEN retur                
   IF y> = 180 THEN GOTO taste
kleber:                             
   x = FIX (x/20): y = FIX(y/20)
   x = x*20: y = y*20
   IF w = 19 AND mx<>-1 THEN PUT(mx,my),bau(110,19)
   IF x = mx AND y = my THEN mx = -1
   IF w<19 THEN PUT(x,y),bau(110,w),PSET :ELSE PUT(x,y),bau(110,19)
   mx = x: my = y
   GOTO retur 
taste:                           
   rx = MOUSE(1)
   rx = FIX(rx/20): y = FIX(y/20): y = y*20
   IF y = 180 THEN w = rx
   IF y = 200 AND rx<5 THEN w = 15+rx 
   IF y = 200 AND rx> = 5 THEN druecke
   a = MOUSE(0) 
   GOTO retur
'**************************
druecke:
    rx = MOUSE(1)
    IF rx <160 AND rx >120 THEN sauber
    IF rx <220 AND rx >180 THEN GOSUB screenDump
    IF rx <280 AND rx >240 THEN GOTO ende    
sauber:
    LINE (20,20)-(280,178),0,bf
    GOTO retur
bauen:
  FOR a = 0 TO 14 
  x = a*20
  PUT (x,182), bau(110,a),PSET
  NEXT
  FOR a = 15 TO 19
  x =  a*20-300
  PUT (x,202), bau(110,a),PSET
  NEXT
      CIRCLE (140,220),20,16,,,0.5:PAINT(140,220),16
      CALL tool (125,220):COLOR 7,16:LOCATE 28,17:PRINT "NEU"
      CIRCLE (204,220),22,16,,,0.5 :PAINT(200,220),16
      CALL tool (185,220):COLOR 7,16:LOCATE 28,24:PRINT "DRUCK"
      CIRCLE (270,220),22,16,,,0.5:PAINT (270,220),16
      CALL tool (265,220):COLOR 7,16:LOCATE 28,33:PRINT "ENDE"
  RETURN 
Rahmen:
   l=1:h=1
   COLOR 20,0
   LOCATE 3,5:PRINT "Geben Sie bitte ein"
   LOCATE 6,5:PRINT "Raummindestmasse 10 * 8 m"
   LOCATE 9,12:  INPUT"Länge   ";l            ' Länge
   LOCATE 12,12:  INPUT"Breite  ";h           ' Breite
   CLS
   IF l< 11 THEN a = 282
   IF h<  9 THEN b = 180
   LINE(18,18)-(a,b),21,b             
   LINE(19,19)-(a-1,b-1),21,b   
   e=18 :f=18
   FOR x = 18 TO a STEP (a-18)/l         
   LINE (x,e-5) - (x,e+1),2
   NEXT x   
   FOR y = 18 TO b STEP (b-18)/h         
   LINE (f-5,y) - (f+1,y),2
   NEXT y
   COLOR 20,0:LOCATE 2,35:PRINT l 
   COLOR 20,0:LOCATE 22,1:PRINT h
   LINE(18,18)-(a,b),21,b 
   LINE(19,19)-(a-1,b-1),21,b 
   SUB tool(c%,d%) STATIC
   xa&=WINDOW(8)+36:ya&=WINDOW(8)+38
   POKEW xa&,c%
   POKEW ya&,d%
   END SUB

radier:
   LINE (0,0)-(20,20),0,bf
   RETURN

fenstero:
   LINE (0,10)-(19,19),11,b
   LINE (0,10)-(19,19),11
   LINE (0,19)-(19,10),11
   RETURN

fensteru:
   LINE (0,0)-(19,10),11,b
   LINE (0,0)-(19,10),11
   LINE (0,10)-(19,0),11
   RETURN
fensterl:
   LINE (0,0)-(10,19),11,b
   LINE (0,0)-(10,19),11
   LINE (10,0)-(0,19),11
   RETURN

kreuz:
   LINE (0,0)-(19,19),11,b
   LINE (0,0)-(19,19),11
   LINE (0,19)-(19,0),11
   RETURN

stuhl:
  CIRCLE (10,10),6,21,,,1
  PAINT (10,10),21 
  RETURN

vierb:
  LINE (0,0)-(19,3),19,bf
  LINE (0,0)-(3,19),19,bf
  LINE (16,0)-(19,16),19,bf
  LINE (0,16)-(19,19),19,bf
  RETURN

tisch:
  LINE (0,0)-(19,19),20,bf
  RETURN

fensterr:
  LINE (10,0)-(19,19),11,b
  LINE (10,0)-(19,19),11
  LINE (10,19)-(19,0),11
  RETURN

rechts:
  LINE (10,0)-(19,19),28,bf
  RETURN

links:
  LINE (0,0)-(10,19),28,bf
  RETURN

balkenu:
  LINE (0,10)-(19,19),28,bf
  RETURN

balkeno:
  LINE (0,0)-(19,10),28,bf
  RETURN

kasten:
  LINE (10,1)-(1,10),18
  LINE -(10,19),18
  LINE -(19,10),18
  LINE -(10,1),18
  PAINT (10,14),18
  RETURN

eckelu:
   LINE (0,0)-(10,19),11,b
   LINE (10,10)-(19,19),11,b
   LINE (10,11)-(10,18),0
   RETURN

eckero:
LINE (0,0)-(19,10),11,b
LINE (10,10)-(19,19),11,b
LINE (11,10)-(18,10),0
RETURN

eckeur:
LINE (0,10)-(19,19),11,b
LINE (10,0)-(19,10),11,b
LINE (11,10)-(18,10),0
RETURN

eckeol:
LINE (0,0)-(19,10),11,b
LINE (0,0)-(10,19),11,b
LINE (10,1)-(10,9),0
LINE (1,10)-(9,10),0
RETURN

stuhlk:
LINE (5,5)-(15,15),3,bf
RETURN

tischgr:
CIRCLE (10,10),8,0,,,1:PAINT(10,10),0
RETURN

screenDump:
LINE (0,180)-(300,248),0,bf

IF AlreadyDeclared = 0 THEN
 DECLARE FUNCTION AllocSignal%() LIBRARY
 DECLARE FUNCTION AllocMem&()    LIBRARY
 DECLARE FUNCTION FindTask&()    LIBRARY
 DECLARE FUNCTION DoIO&()        LIBRARY
 DECLARE FUNCTION OpenDevice&    LIBRARY
 AlreadyDeclared = 1
END IF

sWindow&   = WINDOW(7)
sScreen&   = PEEKL(sWindow& + 46)
sViewPort& = sScreen& + 44
sRastPort& = sScreen& + 84
sColorMap& = PEEKL(sViewPort& + 4)


maxWidth%  = PEEKW(sScreen& + 12)
maxHeight% = PEEKW(sScreen& + 14)        
viewModes% = PEEKW(sViewPort& + 32)

command%  = 11   'Drucker-Befehls-Nummer
srcX% = 0        'Sende ganzen Screen
srcY% = 0 
srcWidth%  = maxWidth%
srcHeight% = maxHeight%
destRows& = 0    
destCols& = 0
special% = &H84  'FullCol | Aspect

IF BorderFlag% = 0 THEN  'Kein Rahmen
   srcX% = srcX% + 3
   srcY% = srcY% + 11
   srcWidth%  = srcWidth% - 3 - 11
   srcHeight% = srcHeight% - 11 - 3
END IF   

LIBRARY "exec.library"


sigBit% =  AllocSignal%(-1)
ClearPublic& = 65537
msgPort& = AllocMem&(40,ClearPublic&)
IF msgPort& = 0 THEN
   PRINT "msgPort nicht allokierbar."
   GOTO cleanup4
END IF


POKE(msgPort& + 8), 4 'Type=NT_MSGPORT
POKE(msgPort& + 9), 0 'Priority 0 
portName$ = "MyPrtPort"+CHR$(0)
POKEL(msgPort& + 10), SADD(portName$)
POKE(msgPort& + 14), 0 'Flags
POKE(msgPort& + 15), sigBit%
sigTask& = FindTask&(0)
POKEL(msgPort& + 16), sigTask&

CALL AddPort(msgPort&)  'Port hinzufuegen


ioRequest& = AllocMem&(64,ClearPublic&)
IF ioRequest& = 0  THEN
   PRINT "ioRequest nicht allokierbar."
   GOTO cleanup3
END IF

POKE(ioRequest& + 8),5 'Type=NT_MESSAGE
POKE(ioRequest& + 9),0 'Priority 0
POKEL(ioRequest& + 14), msgPort&


devName$ = "printer.device"+CHR$(0)
pError& = OpenDevice&(SADD(devName$),0,ioRequest&,0)
IF pError& <> 0  THEN
   PRINT "Drucker nicht ansprechbar."
   GOTO cleanup2
END IF


POKEW(ioRequest& + 28), command%
POKEL(ioRequest& + 32), sRastPort&
POKEL(ioRequest& + 36), sColorMap&
POKEL(ioRequest& + 40), viewModes%
POKEW(ioRequest& + 44), srcX%
POKEW(ioRequest& + 46), srcY%
POKEW(ioRequest& + 48), srcWidth%
POKEW(ioRequest& + 50), srcHeight%
POKEL(ioRequest& + 52), destCols&
POKEL(ioRequest& + 56), destRows&
POKEW(ioRequest& + 60), special%

ioError& = DoIO&(ioRequest&)
IF ioError& <> 0 THEN
   PRINT "DumpRPort Fehler =" ioError&
   GOTO cleanup1
END IF

cleanup1:
   REM  *** Close Printer Device ***
   CALL CloseDevice(ioRequest&)

cleanup2:
   REM  *** DeleteExtIO ***
   POKE(ioRequest& + 8), &Hff
   POKEL(ioRequest& + 20), -1
   POKEL(ioRequest& + 24), -1
   CALL FreeMem(ioRequest&,64)

cleanup3:
   REM  *** DeletePort ***
   CALL RemPort(msgPort&)
   POKE(msgPort& + 8), &Hff  
   POKEL(msgPort& + 20), -1
   CALL FreeSignal(sigBit%)
   CALL FreeMem(msgPort&,40)
   
cleanup4:
   
   LIBRARY CLOSE  
END      
ende:
WINDOW CLOSE 2:SCREEN CLOSE 2
SYSTEM   
END
 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 '
 'Detlef Kornatz
 'Feuerbachstrasse 6
 'D-4300 ESSEN 1
 '
 '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++